(*:Version: Mathematica 2.0 *)
(*:Name: SymbOpt *)
(*:Title: Tools for symbolic optimization *)
(*:Author: Hal Varian, March 1992 *)
(*:Legal: Copyright (c) 1992, Hal Varian *)
(*:Summary:
  This package provides tools for analyzing the qualitative behavior of 
  solutions to optimization problems using the standard tools of comparative
  statics analysis.*)
(*:Keywords: optimization, sensitivity, comparative statics *)
(*:Requirements: No special system requirements. *)
(*:Warning: Grad is used in some other Packages. *)
(*:Sources: Varian, H., Microeconomic Analysis, W. W. Norton and Co., 1992 *)


BeginPackage["SymbOpt`"]

Grad::usage =
	"Grad[f[x1,..,xn],{x1,...,xn}] calculates the vector of partial derivatives of f wrt the x's."

Hesian::usage =
	"Hesian[f[x1,...,xn],{x1,...,xn}] calculates the Hesian matrix."
	
FOC::usage =
    "FOC[f[x1,...,xn],{x1,...,xn}] gives the list of first-order conditions for optimizing
     f with respect to the choice variables x1,...,xn."
     
PrincipalMinors::usage =
     "PrincipalMinors[m,ord] gives the list of principal minors of order ord of the matrix m."
     
NaturalMinors::usage =
     "NaturalMinors[m] gives the list of naturally ordered principal minors of the matrix m."
     
PrependBorder::usage =
      "PrependBorder[m,b] borders the matrix m with (0,b) as the first row and first column."
      
AppendBorder::usage =
      "AppendBorder[m,b] borders the matrix m with (b,0) as the last row and first column."
      
Sensitivity::usage =
 	   "Sensitivity[f,x] yields the derivatives of the optimal choices, x, with respect to all other arguments of the function f.  The determinant of the Hesian matrix is denoted by detHess."

ConsumerPlot::usage =
       "ConsumerPlot[u,p1,p2,m] draws the budget line p1x1 + p2x2=m and the indifference curve for the utility function u[x1,x2] passing through the optimal choice.  It uses FindMin to find the optimum numerically and may fail in some cases."

Begin["`Private`"]
	   
Grad[f_,x_] := Map[D[f,#]&,x]

Hesian[f_,x_] := Grad[Grad[f,x],x]

FOC[f_,x_] := Map[(D[f,#]==0)&,x]

PrincipalMinors[m_,ord_] :=
   Module[{i},
   Table[Minors[m,ord][[i,i]],{i,1,Dimensions[m][[1]]}]]

NaturalMinors[m_]:=
   Module[{i},
   Table[Det[m[[Range[1,i],Range[1,i]]]],{i,1,Dimensions[m][[1]]}]]

PrependBorder[m_,b_] :=
   Module[{i}, 
   Prepend[Table[Prepend[m[[i]],b[[i]]],{i,1,Dimensions[m][[1]]}],Prepend[b,0]]]

AppendBorder[m_,b_] :=
   Module[{i},
   Append[Table[Append[m[[i]],b[[i]]],{i,1,Dimensions[m][[1]]}],Append[b,0]]]
   
Sensitivity[f_,x_] := 
			Solve[Dt[Grad[f,x]==0],Dt[x]][[1]]/.
			{-Det[Hesian[f,x]]->"-detHesian",
			  Det[Hesian[f,x]]->"detHesian"}

(* Consumer plot routines *)

budgetLine[p1_,p2_,m_] :=
Module[{width,x1,x2}, 
   width=Max[m/p1,m/p2];
   ContourPlot[p1*x1 + p2*x2,
       {x1,0,width},{x2,0,width},
   ContourShading->False,Contours->{m},
   DisplayFunction->Identity]
       ]

indifferenceCurves[u_, levelsList_, width_] :=
Module[{x1,x2},
    ContourPlot[u[x1,x2],{x1,1,width},{x2,1,width},
      ContourShading->False, 
      Contours->levelsList,
      DisplayFunction->Identity]
      ]

maxUtility[u_,p1_,p2_,m_] := 
Module[{x1,x2},
   -FindMinimum[-u[x1,(m-p1*x1)/p2],{x1,.1,1}][[1]]
      ]

ConsumerPlot[u_,p1_,p2_,m_] :=
Module[{width,x1,x2,bl,ic,umax},
      width=Max[m/p1,m/p2];
      umax=maxUtility[u,p1,p2,m];
      bl=budgetLine[p1,p2,m];
      ic=indifferenceCurves[u,{umax},width];
      Show[{ic,bl},
         DisplayFunction->$DisplayFunction,
         AxesOrigin->{0,0}]
      ]    
						
(* The following routine courtesy of Scott Harold *)
(* It changes the output format for derivatives *)
(* Modifed by H. Varian to eliminate superscript "1"'s *)
Format[Derivative[i__][u_][x__]] := doDerForm[{i},u,{x}];
Clear[doDerForm]
doDerForm[{i__Integer}, u_, {x__}] :=
Block[{ord,bot,s,t,m,n},
    ord = Plus[i];
  bot[{m_},{s_}] := 
	If[m != 0,SequenceForm["d",ToString[s],If[m>1,Superscript[m]," "]],
        SequenceForm[""]];
  bot[{m_,n__},{s_,t__}] := If[ m != 0, SequenceForm["d",ToString[s],
    If[m>1,Superscript[m]," "], bot[{n},{t}]], bot[{n},{t}]];
        SequenceForm["d",If[ord>1,Superscript[ord],""],ToString[u]]/bot[{i},{x}]
    ]						
End[]
EndPackage[]